home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / dbase / lib19.zip / FIELDS.PRG < prev    next >
Text File  |  1992-09-11  |  14KB  |  393 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: FIELDS.PRG
  3. *-- Programmer: Ken Mayer (KENMAYER)
  4. *-- Date......: 06/25/1992
  5. *-- Notes.....: These field processing routines were deemed as not as commonly
  6. *--             used (at least in my own Applications), and relegated to a 
  7. *--             library file. See: README.TXT about how to use this library
  8. *--             file.
  9. *-------------------------------------------------------------------------------
  10.  
  11. FUNCTION MemoPagr
  12. *-------------------------------------------------------------------------------
  13. *-- Programmer..: Martin Leon (HMAN - ATBBS/Borland BBS)
  14. *-- Date........: 10/28/91
  15. *-- Notes.......: Used to display a memo on screen, allowing user to scroll
  16. *--               memo at will.
  17. *-- Written for.: dBASE IV, 1.1
  18. *-- Rev. History: None
  19. *-- Calls.......: None
  20. *-- Called by...: Any
  21. *-- Usage.......: ?MemoPagr(<cMemo>,<ULRow>,<ULCol>,<BRRow>,<BRCol>)
  22. *-- Example.....: ?MemoPagr(MoreData,10,20,20,65)
  23. *-- Returns.....: .F.
  24. *-- Parameters..: cMemo   = name of memo field
  25. *--               nULRow  = upper left row position
  26. *--               nULCol  = upper left column position
  27. *--               nBRRow  = bottom right row position
  28. *--               nBRCol  = bottom right column position
  29. *-------------------------------------------------------------------------------
  30.     
  31.     PARAMETER cMemo, nULRow, nULCol, nBRRow, nBRCol
  32.     private cCursor, nEsc, nPgDn, nPgUp, nUp, nDn, nNumLines,nLines,nKey
  33.     private nAtLine,nAtRow
  34.     
  35.     *-- set environment
  36.     set memowidth to nBRCol - nULCol - 1
  37.     cCursor = set( "CURSOR" )
  38.     set cursor off
  39.     
  40.     *-- define a few keys
  41.     nEsc  = 27
  42.     nPgDn = 3
  43.     nPgUp = 18
  44.     nUp   = 5
  45.     nDn   = 24
  46.     
  47.     *-- determine size of window
  48.     nNumLines = memlines(&cMemo)
  49.     nLines = nBRRow - nULRow - 1
  50.     *-- save the screen, so we can restore it
  51.     save screen to sTmp
  52.     @ nULRow+1, nULCol+1 clear to nBRRow+1, nBRCol+1
  53.     @ nULRow+1, nULCol+1 fill to nBRRow+1, nBRCol+1 color B/N
  54.     @ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 color RG+/B
  55.     @ nULRow, nULCol to nBRRow, nBRCol double color RG+/B
  56.     
  57.     *-- deal with a blank memo ...
  58.     if nNumLines = 0
  59.        @ nULRow + 1, nULCol + 1 SAY ;
  60.           "Blank Memo.  Press any key to continue..." color RG+/B
  61.        nKey = inkey(0)
  62.         *-- reset the whole thing
  63.        restore screen from sTmp
  64.        release screen sTmp
  65.        set cursor &cCursor
  66.        RETURN .F.
  67.     endif
  68.     
  69.     nAtLine = 1
  70.     nAtRow = 1
  71.     do while nAtLine <= nNumLines
  72.        *-- Show one window full
  73.        do while nAtRow <= nLines .and. nAtLine <= nNumLines
  74.           @ nULRow+nAtRow, nULCol + 1 say ;
  75.              mline( &cMemo, nAtLine ) color RG+/B
  76.           nAtLine = nAtLine + 1
  77.           nAtRow = nAtRow + 1
  78.        enddo
  79.    
  80.        *-- If at last line of memo...
  81.        if nAtLine > nNumLines
  82.           *-- If memo is shorter than one page, put box character in
  83.           *-- bottom left corner of box, otherwise, put an up arrow
  84.           *-- symbol there.
  85.           @ nBRRow - 1, nBRCol SAY ;
  86.          iif( nNumLines <= nLines, chr(186), chr(24)) color W+/B
  87.           do while .T.
  88.              nKey = inkey(0)
  89.              *-- If memo is shorter than one page, only allow Esc key
  90.              if nNumLines <= nLines
  91.                 if nKey = nEsc
  92.                    exit
  93.                 endif
  94.              *-- Otherwise, allow Esc or PgUp keys
  95.              else
  96.                 if nKey = nEsc .or. nKey = nPgUp .or. nKey = nUp
  97.                    exit
  98.                 endif
  99.              endif
  100.              ?? chr(7)
  101.           enddo
  102.           if nKey = nEsc
  103.              restore screen from sTmp
  104.              release screen sTmp
  105.              set cursor &cCursor
  106.              RETURN .F.
  107.           endif
  108.           @ nULRow+1, nULCol+1 clear to nBRRow-1, nBRCol-1
  109.           @ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 ;
  110.              color RG+/B
  111.           nAtLine = nAtLine -  nAtRow - nLines + 1
  112.           nAtLine = iif( nAtLine < 1, 1, nAtLine )
  113.           nAtRow = 1
  114.           loop
  115.        endif
  116.    
  117.        *-- Not at end of memo yet...
  118.        *-- If on first page, show down arrow only, otherwise show
  119.        *-- up/down arrow on border of box.
  120.        @ nBRRow - 1, nBRCol say ;
  121.            iif( nAtLine - nLines = 1, chr(25), chr(18)) color W+/B
  122.        do while .T.
  123.           nKey = inkey(0)
  124.           *-- If this is the first page of the memo on screen...
  125.           if nAtLine - nLines = 1
  126.               *-- Only honor PgDn, up cursor, and Esc keys
  127.              if nKey = nPgDn .or. nKey = nDn .or. nKey = nEsc
  128.                 exit
  129.              endif
  130.           *-- otherwise honor PgUp and up cursor as well key as well
  131.           else 
  132.              if nKey = nPgUp .or. nKey = nUp .or. nKey = nPgDn .or. ;
  133.                     nKey = nDn .or. nKey = nEsc
  134.                 exit
  135.              endif
  136.           endif
  137.           ?? chr(7)
  138.        enddo
  139.        do case
  140.           case nKey = nEsc
  141.              restore screen from sTmp
  142.              release screen sTmp
  143.              set cursor &cCursor
  144.              RETURN .F.
  145.           case nKey = nPgUp .or. nKey = nUp
  146.              @ nULRow+1, nULCol+1 clear to nBRRow-1, nBRCol-1
  147.              @ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 ;
  148.                 color RG+/B
  149.              nAtLine = (nAtLine - (2 * nLines))
  150.              nAtLine = IIF( nAtLine < 1, 1, nAtLine )
  151.              nAtRow = 1
  152.              loop
  153.           case nKey = nPgDn .or. nKey = nDn
  154.              @ nULRow+1, nULCol+1 clear to nBRRow-1, nBRCol-1
  155.              @ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 ;
  156.                 color RG+/B
  157.              nAtRow = 1
  158.              loop
  159.        endcase
  160.     enddo
  161.  
  162. RETURN .F.
  163. *-- EoF: MemoPagr()
  164.  
  165. PROCEDURE ScanMemo
  166. *-------------------------------------------------------------------------------
  167. *-- Programmer..: Martin Leon (HMAN)
  168. *-- Date........: 02/27/1992
  169. *-- Notes.......: This simple procedure is used to strip hard carriage returns
  170. *--               out of all Memos in a database.
  171. *-- Written for.: dBASE IV, 1.1
  172. *-- Rev. History: 04/15/1991 - original procedure.
  173. *--               02/07/1992 -- Douglas P. Saine (XRED) modified to handle
  174. *--                passing of database name as a parameter
  175. *-- Calls.......: None
  176. *-- Called by...: Any
  177. *-- Usage.......: Do ScanMemo with "<cDbf>"
  178. *-- Example.....: Do ScanMemo with "TEST"
  179. *-- Returns.....: None.
  180. *-- Parameters..: cDbf = Name of the database to scan memos ...
  181. *-------------------------------------------------------------------------------
  182.  
  183.     parameter cDbf
  184.     private nFields, cFieldName, nLines, nLineNum
  185.     
  186.     use (cDbf)
  187.     
  188.     scan   && search database 1 record at a time ...
  189.         nFields = 1
  190.         *-- This loop goes through all fields in the database
  191.         do while asc(field(nFields)) # 0
  192.             cFieldName = field(nFields)     && save current field name
  193.             if type(cFieldName) = "M"       && check to see if it's a memo
  194.                 nLines = memlines(&cFieldName)  && number of lines in memo
  195.                 if nLines > 1                   && if there's something there
  196.                     delete file temp.txt         && kill old file if it exists
  197.                     set printer to file temp.txt && copy memo a line at a time to
  198.                     nLineNum = 1                 && temp file, using ??? command.
  199.                     do while nLineNum <= nLines
  200.                         ??? mline(&cFieldName,nLineNum)
  201.                         ??? " "
  202.                         nLineNum = nLineNum + 1
  203.                     enddo
  204.                     close printer
  205.                     set printer to
  206.                     append memo &cFieldName from temp.txt overwrite
  207.                 endif  && nLines > 1
  208.             endif  && type(cFieldName) = "M"
  209.             nFields = nFields + 1  && go to next field ...
  210.         enddo  && asc(field....
  211.     endscan  && scan of database record by record ...
  212.     
  213.     use  && close database
  214.  
  215. RETURN
  216. *-- EoP: ScanMemo
  217.  
  218. PROCEDURE Cut
  219. *-------------------------------------------------------------------------------
  220. *-- Programmer..: Michael B. Carlisle (Borland)
  221. *-- Date........: 01/xx/1992 
  222. *-- Notes.......: This retrieves information from the field the user has
  223. *--               currently selected and stores the information into a 
  224. *--               memory variable titled CLIPBOARD. The field itself is
  225. *--               then cleared. CLIPBOARD should be declared public. 
  226. *--               This routine is taken from TECHNOTES.
  227. *-- Written for.: dBASE IV, 1.1
  228. *-- Rev. History: None
  229. *-- Calls.......: None
  230. *-- Called by...: Any
  231. *-